home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 March - Disc 1 / Macworld (1999-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Modes / adaMode.tcl next >
Encoding:
Text File  |  1998-08-07  |  3.2 KB  |  98 lines  |  [TEXT/ALFA]
  1.  
  2. alpha::mode Ada 1.0.1 dummyAda {*.ada *.ads *.adb *.ADS *.ADB *_.a *.a } {
  3.     electricBraces electricSemicolon electricTab
  4. }
  5.  
  6. #===============================================================================
  7. # From Raymond Waldrop <rwaldrop@cs.tamu.edu>
  8. #===============================================================================
  9.  
  10. newPref v leftFillColumn {3} Ada
  11. newPref v prefixString {-- } Ada 
  12. newPref v wordBreak {[a-zA-Z0-9_]+} Ada
  13. newPref f wordWrap {0} Ada
  14. newPref v funcExpr {^[ \t]*(procedure|function)[ \t]+([A-Za-z][A-Za-z0-9_]*)} Ada
  15. newPref v parseExpr {^[ \t]*[^ \t]+[ \t]+([A-Za-z][A-Za-z0-9_]*)} Ada
  16. newPref v wordBreakPreface {[^a-zA-Z0-9_]} Ada
  17.  
  18. # Don't get used!
  19. #set adaCommentRegexp    {/\*(([^*]/)|[^*]|\r)*\*/}
  20. #set adaPreRegexp        {^\#[\t ]*[a-z]*}
  21. set adaKeyWords        {
  22.     abort abs accept access all and array at begin body case constant
  23.     declare delay delta digits do else elsif end entry exception exit
  24.     for function generic goto others if in is limited loop mod new not
  25.     null of or subtype out package pragma private procedure raise range
  26.     record rem renames return reverse select separate task terminate
  27.     then type use when while with xor = /=  := > < abstract aliased 
  28.     protected requeue tagged until
  29.     }
  30. regModeKeywords -e {--} -c magenta -k blue Ada $adaKeyWords -i ")" -i "(" -i ":" -i ";" -i "," -i "." -I blue
  31.  
  32. proc dummyAda {} {}
  33.  
  34. #===============================================================================
  35. # From Tom Konantz
  36. #===============================================================================
  37.  
  38. proc Ada::MarkFile {} {
  39.     global AdamodeVars
  40.     set pos [minPos]
  41.     
  42.     while {![catch {search -s -f 1 -r 1 -m 0 -i 1 $AdamodeVars(funcExpr) $pos} res]} {
  43.         set start [lindex $res 0]
  44.         set end [pos::math [lindex $res 1] + 1]
  45.         set text [getText $start $end]
  46.                 
  47.         if {[regexp    -nocase    -indices {(procedure|function)[    \t]+([a-zA-Z0-9_]+)} $text dummy dummy0    pname]}    {
  48.             set    i1 [expr [lindex $pname    0]    + $start]
  49.             set    i2    [expr [lindex $pname 1]    + $start + 1]
  50.             set    word  [getText $i1 $i2]
  51.             set    tmp    [concat    $i1    $i2]
  52.             
  53.             if {[info exists cnts($word)]} {
  54.                 # This section handles duplicate. i.e., overloaded names
  55.                 set cnts($word) [expr $cnts($word) + 1]
  56.                 set ol_word [ join [concat $word "#" $cnts($word)] ""]
  57.                 set inds($ol_word) $tmp
  58.             } else {
  59.                 set cnts($word) 1
  60.                 set inds($word) $tmp
  61.             }
  62.         }
  63.  
  64.     
  65.         set pos $end
  66.     }
  67.     if {[info exists inds]} {
  68.       foreach f [lsort -ignore [array names inds]] {
  69.             set res $inds($f)
  70.             setNamedMark $f [lineStart [lindex $res 0]] [lindex $res 0] [lindex $res 1]
  71.         }
  72.     }
  73. }
  74.  
  75. # the following will switch between the Ada spec & body,
  76. # assuming they're in the same directory
  77. # and use either GNAT or VAX Ada naming conventions.
  78. # other conventions can be supported fairly easily.
  79. proc otherPart {} {
  80.     set curname [win::Current]
  81.     if {[regsub  "(.*)\.ads" $curname {\1.adb} tgtname]}  {
  82.         file::openQuietly $tgtname
  83.     } elseif  {[regsub  "(.*)\.adb" $curname {\1.ads} tgtname]}  {
  84.         file::openQuietly $tgtname
  85.     # Next clause must precede the one after it!
  86.     } elseif  {[regsub  {(.*)_\.a$} $curname {\1.a} tgtname]}  {
  87.         file::openQuietly $tgtname
  88.     } elseif  {[regsub  {(.*)\.a$} $curname {\1_.a} tgtname]}  {
  89.         file::openQuietly $tgtname
  90.     } else {
  91.          error "NoMatch"
  92.     }
  93. }
  94.  
  95. Bind f9 otherPart Ada
  96.  
  97.  
  98.